'Programma A5-Boekje, september 2004

DEFINT A-Z
VM = 24: HM = 80
VD$ = MID$(DATE$,4,3)+LEFT$(DATE$,3)+RIGHT$(DATE$,4)
SHARED VE, HO, VM, HM, M$(), VD$, UN
SHARED Opschr1$, Opschr2$, Opschr3$,TOPA5
SHARED TOVA4, TOPBU, WAKAT, Printer$, Papier$, INV%, INV$, Opdr$

'VE = Schermregel,HO = Schermkolom,
'VM = max.aantal schermregels
'HM = Max.aantal schermkolommen,VD$ = Datum

'UN wordt straks bij het afdrukken gebruikt, met deze methode 
'hoeven we alle af te drukken regels maar 1x te programmeren, de 
'waarde van UN bepaalt dan of er op het scherm of op de printer 'afgedrukt wordt.

ON ERROR GOTO FOUTCODE
Hoofdmenu:
	WHILE AF% = 0
		M$(0) = "A5-Boekje, inslagschema"
    M$(1) = "Starten"
    M$(2) = "Stoppen"
    M$(3) = "."
    CALL Menu(INV%)
    SELECT CASE INV%
    	CASE 1: GOSUB BEGINNEN: CLOSE
      CASE 2: AF% = -1: : CLOSE
    END SELECT
  WEND
  CLS
END

FOUTCODE:
BEEP: COLOR 15,5: LOCATE 25,2: PRINT ">> ";
PRINT "U heeft een fout gemaakt ";
PRINT "die niet tijdens deze run hersteld kan worden";
SLEEP 2: CLOSE: CALL Scherm: GOTO Hoofdmenu

BEGINNEN:
CALL Scherm: PRINT
PRINT " Dit programma berekent de samenstelling van een";
PRINT " A5 boekje dat op A4 papier";
PRINT " afgedrukt wordt. Per kant A4 kunnen 2 pagina's A5";
PRINT " afgedrukt worden, per ";
PRINT " liggend vel A4 zijn dit dus 4 pagina's A5.": PRINT
PRINT " Het totaal aantal pagina's A5 en ook het aantal"; 
PRINT " pagina's A5 per katern"
PRINT " moet altijd een veelvoud van 4 zijn. ";
PRINT " Dit betekent dat als de deling van het totaal aantal"
PRINT " A4 vellen door het aantal A4 vellen per katern geen"
PRINT " geheel getal oplevert er automatisch blanco" 
PRINT " A4-vellen worden toegevoegd."
LOCATE 12,5
PRINT "Inslagschema afdrukken op scherm(s) of op printer(p) ?";
Afdruk$ = ""
DO
  Toets$ = INPUT$(1): Afdruk$ = LCASE$(Toets$)
  IF Afdruk$ = "s" OR Afdruk$ = "p" THEN
    LOCATE 12,60: PRINT Afdruk$: EXIT DO
  END IF
LOOP
IF Afdruk$ = "s" THEN
  OPEN "SCRN:" FOR OUTPUT AS #1
ELSEIF Afdruk$ = "p" THEN
	LOCATE 14,1: PRINT SPACE$(80);: LOCATE 14,1
  PRINT " Er wordt U direct gevraagd of de afdruk op een DOS";
  PRINT " of WINDOWS printer"
  PRINT " moet geschieden. Onder een WINDOWS-printer";
  PRINT " wordt hierbij een printer"
  PRINT " verstaan die GEEN DOS-COMMANDO'S herkent.";
  PRINT " Doet hij dit wel dan moet U"
  PRINT " voor DOS (D) kiezen ook al drukt U onder Windows af."
  Opdr$="vervolg"
CALL Gezien: LOCATE 14,1: PRINT STRING$(300,32): LOCATE 14,5
  PRINT "DOS(D) of WINDOWS(W) PRINTER ? ";: Printer$ = ""
	DO
  	Toets$ = INPUT$(1): Printer$ = UCASE$(Toets$)
  	IF Printer$ = "D" OR Printer$ = "W" THEN
    LOCATE 14,36: PRINT Printer$: EXIT DO
  	END IF
	LOOP
  IF Printer$ = "D" THEN
  	OPEN "LPT1:" FOR OUTPUT AS #2
  ELSEIF Printer$ = "W" THEN
  	OPEN "A5.TXT" FOR OUTPUT AS #2
  END IF
  LOCATE 15,5: PRINT SPACE$(75);: LOCATE 15,5
  PRINT "PAPIER-LENGTE
  A4 = 29,7 cm (A) of LETTER = 27,9 cm (L) ? ";
  Papier$ = ""
  DO
  	Toets$ = INPUT$(1): Papier$ = UCASE$(Toets$)
  	IF Papier$ = "A" OR Papier$ = "L" THEN
    	LOCATE 15,63: PRINT Papier$: EXIT DO
  	END IF
	LOOP
  END IF

TOPA5 = -1: TOPBU = -1                      'TOPA5 = Totaal aantal A5-pagina's
WHILE TOPA5 MOD 4 <> 0 OR TOPA5 <= 0  	'TOPBU = Aantal A5-pagina's per katern
   LOCATE 17,1: PRINT STRING$(79,32)
   LOCATE 17,5
      INPUT "Hoeveel pagina's A5 ? (altijd een veelvoud van 4) ",TOPA5
WEND
TOVA4 = 0.25*TOPA5                     	'TOVA4 = Totaal aantal A4-vellen

WHILE TOPBU MOD 4 <>0 AND TOPBU<>0 OR TOPBU>TOPA5 OR TOPBU = 0
   LOCATE 19,1: PRINT STRING$(79,32)
   LOCATE 19,5
INPUT "Hoeveel pagina's A5 per katern ? ook een veelvoud van 4) ", _
                                                                TOPBU
WEND
TOVBU = 0.25*TOPBU          	               'TOVBU = Aantal A4-vellen per katern

LOCATE 17,1: PRINT STRING$(79,32)
LOCATE 17,5: PRINT  "Aantal pagina's A5 = ";USING"####";TOPA5
LOCATE 17,35
PRINT "Aantal pagina's A5 per katern = ";USING"####";TOPBU
LOCATE 19,1: PRINT STRING$(79,32)

REDIM VKL(TOPA5),VKR(TOPA5),AKL(TOPA5),AKR(TOPA5)

REM Berekening en afdrukken
BAKAT = INT(TOVA4/TOVBU)      'BAKAT = Berekend Aantal Katernen
IF TOVA4 MOD TOVBU <> 0 THEN  'als dit niet een geheel getal is
	WAKAT = BAKAT + 1     	'dan komt er 1 katern bij
  				'TOVA4 = TOVBU * WAKAT
ELSE                          'WAKAT = Werkelijk Aantal Katernen
	WAKAT = BAKAT
END IF
LOCATE 19,5
PRINT "Aantal A4 vellen   = ";USING"####";TOVA4
LOCATE 19,35
PRINT "Aantal A4 vellen per katern   = ";USING"####";TOVBU
LOCATE 21,5
PRINT "Aantal katernen    = ";USING"####";WAKAT
BLANKA5 = WAKAT*TOPBU-TOPA5 	'BLANKA5 = Aantal blanco A5 pagina's
LOCATE 21,35: PRINT "Aantal blanco A5-pagina's =";BLANKA5
Doorgaan$ = ""
LOCATE 23,18: PRINT "Doorgaan (j/n) ? ";
DO
 	Toets$ = INPUT$(1): Doorgaan$ = LCASE$(Toets$)
  	IF Doorgaan$ = "j" OR Doorgaan$ = "n" THEN
    	LOCATE 23,35: PRINT Doorgaan$: EXIT DO
  	END IF
LOOP

IF Doorgaan$ = "n" THEN CLOSE: RETURN
'Opdr$ = "vervolg"
CALL Gezien
Opschr1$ = " Katern     Vel                 Voorkant        |   Achterkant,"
Opschr2$ = "   nr.      nr.            Links    |  Rechts   | Links  |  Rechts"
Opschr3$ = " "+ STRING$(66,45)
IF Afdruk$ = "s" THEN UN = 1 ELSE UN = 2
IF UN = 2 THEN
  PRINT #UN,SPACE$(29);M$(0)
  PRINT #UN, SPACE$(29);STRING$(23,45): PRINT #UN,
  PRINT #UN, "Aantal pagina's A5 = ";USING"####";TOPA5;
  PRINT #UN, STRING$(5,32);"Aantal pagina's A5 per katern = ";USING"####";TOPBU
  PRINT #UN, "Aantal A4 vellen   = ";USING"####";TOVA4;
	PRINT #UN, STRING$(5,32);"Aantal A4 vellen per katern   = ";USING"####";TOVBU
  PRINT #UN, "Aantal katernen    = ";USING"####";WAKAT: PRINT #UN,
ELSE
  CALL Scherm
END IF
PRINT #UN, Opschr1$: PRINT #UN, Opschr2$: PRINT #UN, Opschr3$
A5Regel = 5       			'De A5Regel laten we meelopen i.v.m. het netjes afdrukken
FOR TELLER = 1 TO WAKAT
	IF TELLER = 1 THEN
  	PAGMAX = TOPBU: 		'PAGMAX is het hoogste A5-paginanummer van een katern
	  PAGMIN = PAGMAX - TOPBU + 1	'PAGMIN is het laagste A5-paginanummer van
  ELSEIF TELLER = WAKAT THEN     	'hetzelfde katern
  	PAGMAX = TOPA5: PAGMIN = (WAKAT-1) * TOPBU + 1
  ELSE
  	PAGMAX = TELLER * TOPBU: PAGMIN = PAGMAX - TOPBU + 1
  END IF
  V = 1           	'V   = A4-vel nr.1 van een katern
  			'VKL = Voorkant links en 
			'VKR = Voorkant rechts van hetzelfde A4-vel
  			'AKL = Achterkant links en 	
			'AKR = Achterkant rechts van hetzelfde A4-vel
	VKL(V) = PAGMAX: VKR(V) = PAGMIN
  AKL(V) = VKR(V) + 1: AKR(V) = VKL(V) - 1
  IF TELLER > 1 AND A5Regel > 5 THEN
  	PRINT #UN,: A5Regel = A5Regel+1
  END IF
  PRINT #UN, "  ";USING"###";TELLER;:PRINT #UN,"      ";USING"###";(V);
  PRINT #UN, "   A5-Pagina ";USING"####";VKL(V);: PRINT #UN,"       ";
  PRINT #UN, USING"####";VKR(V);: PRINT #UN, "    |   ";
  PRINT #UN, USING"####";AKL(V);: PRINT #UN, "  |   ";
  PRINT #UN, USING"####";AKR(V):
	A5Regel = A5Regel + 1: CALL Nieuwblad(A5Regel)
  IF TOVBU > 1 THEN
	  FOR I = (V+1) TO TOVBU
  	  VKL(I) = AKR(I-1)-1: VKR(I) = AKL(I-1)+1
      AKL(I) = VKR(I)+1: AKR(I) = VKL(I)-1
      IF A5Regel = 5 THEN
      	PRINT #UN, "  ";USING"###";TELLER;
      	PRINT #UN, STRING$(6,32);USING"###";(I);
      	PRINT #UN,"   A5-Pagina ";
      ELSE
      	PRINT #UN, STRING$(11,32);USING"###";(I);
	PRINT #UN, STRING$(13,32);
      END IF
      PRINT #UN, USING"####";VKL(I);: PRINT #UN,"     |   ";
  		PRINT #UN, USING"####";VKR(I);: PRINT #UN, "    |   ";
  		PRINT #UN, USING"####";AKL(I);: PRINT #UN, "  |   ";
		PRINT #UN, USING"####";AKR(I)
			A5Regel = A5Regel+1
      IF TELLER = WAKAT AND AKR(I)-AKL(I) = 1 THEN EXIT FOR
			CALL Nieuwblad(A5Regel)
  	NEXT I
	END IF
  IF TELLER = WAKAT THEN
     'BLANKA5 = WAKAT*TOPBU-TOPA5 'BLANKA5 = Aantal blanco A5 pagina's
    IF BLANKA5 > 0 THEN
    	IF UN = 1 AND A5Regel = 23 THEN
           PRINT #UN," Aantal blanco pagina's A5 = ";BLANKA5
      ELSEIF UN = 1 AND A5Regel > 23 THEN
 	 CALL Scherm: PRINT #UN,
         PRINT #UN," Aantal blanco pagina's A5 = ";BLANKA5
      ELSE
         PRINT #UN,: PRINT #UN," Aantal blanco pagina's A5 = ";BLANKA5
      END IF
    END IF
    IF UN = 2 THEN
      PRINT #UN, CHR$(12)
    END IF
    Opdr$ = "gezien": CALL Gezien: COLOR 7,0: CLS: EXIT FOR
  END IF
NEXT TELLER
RETURN

SUB Nieuwblad(A5Regel)
  IF UN = 1 AND A5Regel >= 24 THEN
     Opdr$ = "vervolg": CALL Gezien: CALL Scherm
     PRINT #UN, Opschr1$: PRINT #UN, Opschr2$: PRINT #UN, Opschr3$
     A5Regel = 5
  ELSEIF (UN = 2 AND Papier$ = "L" AND A5Regel >= 55) OR _
     (UN = 2 AND Papier$ = "A" AND A5Regel >= 56) THEN
     PRINT #UN, CHR$(12): CALL Scherm: LOCATE 5,1
        IF Printer$ = "D" THEN
    	    PRINT "  U kunt straks het blad omdraaien en het aan
            PRINT " de andere kant bedrukken"
            Opdr$ = "vervolg": CALL Gezien: CALL Scherm
        ELSEIF Printer$ = "W" THEN
            PRINT " Er wordt nu in deze directory een 
            PRINT " file 'A5.TXT' aangemaakt die U met een"
            PRINT " Windows-printer (die geen DOS-commando's kent) 
            PRINT " onder Windows afdrukken"
            PRINT " kunt met behulp van het programma Word, 
            PRINT " font Courier new, lettergrootte 10 mm. "
            PRINT " Voor een nette afdruk van het schema met
            PRINT " behulp van een andere"
            PRINT " tekstverwerker dient U in elk geval de
            PRINT " rechtermarge op maximaal 15 mm in"
            PRINT " te stellen en zonodig de bladovergang
            PRINT " aan te passen."
        END IF
    PRINT #UN,SPACE$(20);M$(0);" (vervolg)"
    PRINT #UN,SPACE$(20);STRING$(33,45)
    PRINT #UN,
    PRINT #UN, Opschr1$
    PRINT #UN, Opschr2$
    PRINT #UN, Opschr3$
		A5Regel = 5
  END IF
END SUB

SUB Scherm
  COLOR 15,5: CLS
 	HO = (HM - LEN(M$(0))) \ 2: VE = 1: LOCATE VE, HO
 	PRINT M$(0); TAB(69); VD$; " ":LOCATE 2, 1: COLOR 0,7
 	FOR I = 1 TO 23: PRINT STRING$(80, 32); : NEXT I: LOCATE 2, 1
END SUB

SUB Gezien
  Tekst$ = ">> Toets voor " : COLOR 15,5
  LOCATE 25,2: PRINT Tekst$;Opdr$;
  WHILE NOT INSTAT: WEND
  LOCATE 25,1: PRINT SPACE$(HM);: COLOR 0,7: WNI$ = INKEY$
END SUB

SUB InvToets
  INV$ = INPUT$(1)
  IF LEN(INV$) < 2 THEN EXIT SUB
  IF (ASC(LEFT$(INV$, 2)) = 3) THEN INV$ = CHR$(0): EXIT SUB
  INV$ = CHR$(ASC(LEFT$(INV$, 2)) + 125)
END SUB

SUB Knop3D(Raam%,VE,HO)
Count% = 1
SELECT CASE Raam%
  CASE 1
    LOCATE VE,HO,0 :COLOR 15,7 :PRINT CHR$(218) + STRING$(Count%,196);
    COLOR 0,7 :PRINT CHR$(191)
    LOCATE VE+1,HO,0 :COLOR 15,7 :PRINT CHR$(179);
    LOCATE ,HO+2,0: COLOR 0,7 :PRINT CHR$(179)
    LOCATE VE+2,HO,0 :COLOR 15,7 :PRINT CHR$(192);
    COLOR 0,7
    PRINT STRING$(Count%,196) + CHR$(217);: LOCATE VE+1,HO+3,0
  CASE 2
    LOCATE VE,HO,0 :COLOR 0,7 :PRINT CHR$(218) + STRING$(Count%,196);
    COLOR 15,7 :PRINT CHR$(191)
    LOCATE VE+1,HO,0 :COLOR 0,7 :PRINT CHR$(179);
    LOCATE ,HO+2,0: COLOR 15,7 :PRINT CHR$(179)
    LOCATE VE+2,HO,0 :COLOR 0,7 :PRINT CHR$(192);
    COLOR 15,7
    PRINT STRING$(Count%,196) + CHR$(217);: LOCATE VE+1,HO+3,0
  END SELECT
END SUB

SUB Menu (INV%)
	LOCATE ,,0
  MARGE = 30
  REM DRUK TITEL AF
  CALL Scherm
  HO = (HM - LEN(M$(0))) \ 2 - 1
  VE = 0: CALL Rijkolom
  COLOR 15,5: PRINT M$(0): COLOR 0,7
  REM DRUK ALTERNATIEVEN AF
  M = 1: HO = MARGE
  IF MAXM > 6 THEN
    VE = VE -1
  ELSE
  	VE = VE + 2
  END IF
  WHILE M$(M) <> "."
     VE = VE + 3: CALL Rijkolom: COLOR 4
     PRINT CHR$(48+M);: COLOR 0: PRINT "  "; M$(M);
     CALL Knop3D(1,ByCopy VE, ByCopy HO)
     M = M + 1
  WEND
  REM KEUZE
  HO = 33: VE = VM: CALL Rijkolom
  COLOR 15, 5: PRINT "KIES EEN CIJFER";
  INV% = 1: INV$ = ""
  WHILE INV$ = ""
     A = 0
     WHILE A < 1 OR A > M - 1
     	 CALL InvToets: A = ASC(INV$) - 48
       IF A > 0 AND A < M THEN
         INV% = A: HO = MARGE
         IF MAXM >6 THEN
       	   VE = INV% * 3 - 1
         ELSE
       	   VE = INV% * 3 + 2
         END IF
         CALL Rijkolom: CALL Knop3D(2,ByCopy VE,ByCopy HO)
         SLEEP 0.5
         CALL Rijkolom: COLOR 0,7: CALL Knop3D(1,ByCopy VE,ByCopy HO)
       END IF
     WEND
  WEND: COLOR 0,7: LOCATE ,,1
END SUB

SUB Rijkolom
  OVE = VE: OHO = HO
  IF OVE > 24 THEN OVE = 24
  IF OVE < 0 THEN OVE = 0
  IF OHO > 79 THEN OHO = 79
  IF OHO < 0 THEN OHO = 0
  LOCATE OVE + 1, OHO + 1
END SUB
